home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 012 / keys2.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1984-04-24  |  4.1 KB  |  94 lines
  1. 5  ' key redefintion program   04/23/83
  2. 6  ' Program by Marty Smith, SOURCE ST2259, COMPUSERVE 72155,1214
  3. 7  ' 310 Cinnamon Oak Lane, Houston TX
  4. 8  ' (713) 661-1241 (Office), (713) 464-6737 (Home)
  5. 10  DEFINT A-Z : KEY OFF : I=0 : QL=127 : CR$="\" : DIM K$(132)
  6. 20  CLS
  7. 30  COLOR 0,7 : PRINT "KEYS.BAS -- ANSI.SYS keyboard redefintion.";: COLOR 7,0 : PRINT
  8. 35  GOSUB 740
  9. 40  PRINT "DOS 2.0 only. The ANSI.SYS device driver must be in your CONFIG.SYS file."
  10. 50  PRINT : PRINT "First you are asked for symbol to use for a RETURN in the string."
  11. 52  PRINT "This defaults to the backslash (\), but can be any key."
  12. 55  PRINT "Then you are asked for a filename to store your new keys."
  13. 60  PRINT : PRINT "    Then:"
  14. 70  PRINT "(1) Press the key to be redefined (or combination, such as ALT+x),"
  15. 80  PRINT "(2) Enter the string, up to 127 characters, followed by a RETURN."
  16. 90  PRINT : PRINT "When finished you can redefine these keys by TYPEing the file created from DOS."
  17. 95  PRINT : PRINT "Please enter a key to use for a RETURN character." :PRINT "Default = ";CR$;"  ";
  18. 97  INPUT NCR$ : IF NCR$<>"" THEN CR$=NCR$
  19. 100  PRINT : FS$="" : LINE INPUT "Please enter a filename for the keys: ";FS$
  20. 105  IF FS$="" THEN PRINT "Need a filespec to store key definitions." : GOTO 500
  21. 110  FOR I=1 TO 10 : KEY I,"" : NEXT
  22. 120  OPEN FS$ FOR OUTPUT AS #1
  23. 200  PRINT "Press the key or combo to be redefined, Esc to end ";: LOCATE ,,1
  24. 210  I$="" : WHILE I$="" : I$=INKEY$ : WEND : IF I$=CHR$(27) THEN 400 ELSE PRINT
  25. 220  IF LEN(I$)=1 THEN KEYS=1 : J$="["+MID$(STR$(ASC(I$)),2,3)+";"
  26. 230  IF LEN(I$)=2 THEN KEYS=2 : J$="[0;"+MID$(STR$(ASC(RIGHT$(I$,1))),2,3)+";"
  27. 240  IF LEN(I$)>2 OR LEN(I$)<1 THEN BEEP : PRINT "Only one key or combination at a time." : GOTO 200
  28. 245  II$=I$ : GOSUB 600
  29. 250  PRINT "Type string to redefine ";:COLOR 15,0: PRINT WHATKEY$;: COLOR 7,0 : PRINT ", use ";CR$;" for a RETURN."
  30. 260  COLOR 15,0 : GOSUB 800 : D$=Q$ : COLOR 7,0 : PRINT
  31. 270  PRINT "Is this OK?"; : LOCATE ,,1 : K$="" : WHILE K$="" : K$=INKEY$ : WEND
  32. 280  IF K$="N" OR K$="n" THEN PRINT :GOTO 200 ELSE PRINT
  33. 310  IF RIGHT$(D$,1)=CHR$(13) THEN D$=LEFT$(D$,LEN(D$)-1) : CR=-1 ELSE CR=0
  34. 320  IF ALT THEN J$=J$+D$ ELSE J$=J$+CHR$(34)+D$+CHR$(34)
  35. 330  IF CR THEN J$=J$+";13p" ELSE J$=J$+"p"
  36. 340  PRINT #1,WHATKEY$+" = ";D$; : IF CR THEN PRINT #1,CR$ ELSE PRINT #1,""
  37. 350  PRINT #1,CHR$(27)+J$
  38. 360  GOTO 200
  39. 400  CLOSE : CLS
  40. 410  OPEN FS$ FOR INPUT AS #1
  41. 415  PRINT "Keys in file ";:COLOR 0,7: PRINT FS$;: COLOR 7,0 : PRINT " to be redefined as:"
  42. 420  WHILE NOT EOF(1)
  43. 430  LINE INPUT #1,A$
  44. 440  IF LEFT$(A$,1)=CHR$(27) THEN 460
  45. 450  PRINT A$
  46. 460  WEND : CLOSE : PRINT "Just TYPE ";FS$;" from DOS to put these keys into effect."
  47. 470  PRINT : PRINT "Create another set of keys?";:LOCATE ,,1
  48. 480  I$="" : WHILE I$="" : I$=INKEY$ : WEND
  49. 490  IF I$="Y" OR I$="y" THEN 100
  50. 500  KEY 1,"LIST " : KEY 2,"RUN"+CHR$(13) : KEY 3,"LOAD"+CHR$(34) : KEY 4,"SAVE"+CHR$(34) : KEY 5,"CONT"+CHR$(13)
  51. 510  KEY 6,","+CHR$(34)+"LPT1" : KEY 7,"TRON"+CHR$(13) : KEY 8,"TROFF"+CHR$(13) : KEY 9,"KEY "
  52. 515  KEY 10,"SCREEN 0,0,0"+CHR$(13)
  53. 520  KEY ON : END
  54. 600  ' Put key press into whatkey$
  55. 610  IF KEYS=1 THEN WHATKEY$=II$+CHR$(32) : GOTO 630
  56. 620  WHATKEY$=K$(ASC(RIGHT$(II$,1)))+CHR$(32)
  57. 630  RETURN
  58. 700  DATA NUL,Shift Tab,Q,W,E,R,T,Y,U,I,O,P,A,S,D,F,G,H,J,K,L,Z,X,C,V,B,N,M
  59. 710  DATA F1,F2,F3,F4,F5,F6,F7,F8,F9,F10,Home,Cursor Up,Pg Up,Cursor Left,Cursor Right,End,Cursor Down,Pg Dn
  60. 720  DATA Ins,Del,Ctrl-PrtSc,Ctrl-Cursor Left,Ctrl-Cursor Right,Ctrl-End,Ctrl-Pg Dn,Ctrl-Home
  61. 730  DATA 1,2,3,4,5,6,7,8,9,0,-,=,Ctrl-Pg Up
  62. 740  READ K$(3) : READ K$(15)
  63. 750  FOR I=16 TO 25 : READ K$(I) : K$(I)="Alt-"+K$(I) : NEXT
  64. 752  FOR I=30 TO 38 : READ K$(I) : K$(I)="Alt-"+K$(I) : NEXT
  65. 754  FOR I=44 TO 50 : READ K$(I) : K$(I)="Alt-"+K$(I) : NEXT
  66. 760  FOR I=59 TO 68 : READ K$(I) : K$(I+25)="Shift-"+K$(I) : K$(I+35)="Ctrl-"+K$(I) : K$(I+45)="Alt-"+K$(I) : NEXT
  67. 770  FOR I=71 TO 73 : READ K$(I) : NEXT : READ K$(75) : READ K$(77)
  68. 775  FOR I=79 TO 83 : READ K$(I) : NEXT : FOR I=114 TO 119 : READ K$(I) : NEXT
  69. 780  FOR I=120 TO 131 : READ K$(I) : K$(I)="Alt-"+K$(I) : NEXT
  70. 790  READ K$(132) : RETURN
  71. 800  ' Q-String subroutine, courtest Andy Fleugleman
  72. 810  ' Q$=string returned,  QL=max length
  73. 820  LOCATE ,,1 : ALT=0
  74. 830  Q$="" : IF QL=0 THEN QL=255
  75. 840  QI$=INKEY$ : IF QI$="" THEN 840
  76. 850  IF QI$=CHR$(13) THEN RETURN
  77. 860  IF QI$<>CHR$(8) THEN 890
  78. 870  IF Q$="" THEN BEEP : GOTO 840
  79. 880  GOSUB 980 : Q$=LEFT$(Q$,LEN(Q$)-1) : GOTO 840
  80. 890  IF LEN(Q$)=QL THEN BEEP : GOTO 840
  81. 900  IF LEN(QI$)=1 THEN 930
  82. 910  IF QI$<>CHR$(0)+CHR$(3) THEN GOTO 1000
  83. 920  QI$=CHR$(0) : GOTO 940
  84. 930  IF ASC(QI$)>31 THEN PRINT QI$;: GOTO 950
  85. 940  COLOR 15:PRINT CHR$(ASC(QI$)+64);:COLOR 7
  86. 950  IF QI$=CR$ THEN Q$=Q$+CHR$(13):GOTO 840
  87. 960  Q$=Q$+QI$:GOTO 840
  88. 970  '
  89. 980  PRINT CHR$(29);" ";CHR$(29);:RETURN
  90. 990  ' return ext. key set up
  91. 1000  Q$=STR$(ASC(RIGHT$(QI$,1))) : MID$(Q$,1,1)=";" : Q$="0"+Q$ : ALT=-1
  92. 1010  II$=QI$ : GOSUB 600 : PRINT WHATKEY$; : RETURN
  93. 1020  ' end subroutine
  94.